home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / SYS_TOOL / MULTI020 / MULTI.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-05  |  8KB  |  196 lines
  1. {$S-}
  2. {$DEFINE DEBUG}
  3. unit Multi;
  4.  
  5. { Multi 0.1 beta, A Unit For Cooperative Multitasking }
  6.  
  7. interface
  8.  
  9. {#T Multitasking-Introduction}
  10. { A short introduction to MULTI
  11.  
  12.   Please do yourself a favour and read the manual. I know that most of
  13.   us hate to read manuals, and I hate to write them, so it is rather
  14.   short, and contains not much overhead (except that annoying constant
  15.   praising of myself, of course ;) )
  16.  
  17.   A Task is basically a far procedure which takes one untyped VAR
  18.   parameter. If anyone calls #Switch#, a different task (if any) is
  19.   invoked. If DEBUG is $DEFINEd, each task has a pointer to a string
  20.   containing an ID which can be dumped to the monochrome monitor.
  21.   Create a task with #Fork#. If the task procedure exits or calls
  22.   #Terminate#, it is killed and no Switch will reach it again. Each
  23.   task has its own stack and can have local variables.
  24.  
  25.   Fork returns a task pointer which can be used to terminate the other
  26.   task or to make it wait for a #Semaphore#. Tasks waiting for a semaphore
  27.   are not reached by Switch until the semaphore (basically a list of
  28.   the waiting tasks or NIL if no tasks are waiting) is #Release#d or
  29.   commits #Kamikaze#.
  30.  
  31.   If a task needs to de-initialize something, it should set #tTask.HasExit#
  32.   TRUE, it will then be called if the program terminates and the task
  33.   is still active. Or if a semaphore is killed and the task waits for
  34.   that semaphore. In that case Switch will return TRUE, the task has to
  35.   de-initialize and kill itself immediately. }
  36.  
  37.  
  38. {$IFDEF DEBUG}
  39. uses dual, nconv;
  40. {$ENDIF}
  41.  
  42. {$IFDEF DEBUG}
  43. const
  44.   debug : boolean = true;
  45.   {#X debugdump Dump}
  46.     { If TRUE, these messages may be printed to the monochrome monitor :
  47.         [Taskname] terminated
  48.         [Taskname] created
  49.         [Taskname] put asleep
  50.           this means the task waits for a semaphore now.
  51.         [Taskname] release
  52.         [Taskname] poisoned
  53.         [Taskname] Halt of RunError
  54.       Only available if DEBUG is $DEFINEd. }
  55.   debugdump : boolean = false;
  56.   {#X debug}
  57.     { If TRUE, sometimes debug dumps will be printed to the monochrome
  58.       monitor. See #Dump# for an example dump.
  59.       Only available if DEBUG is $DEFINEd. }
  60. {$ENDIF}
  61.  
  62. type
  63.   TaskProc = procedure (var v);
  64.     { Template for task procedures. Any procedure you want to be a task
  65.       must look like this and they must be FAR. }
  66.  
  67.   pTask = ^tTask;
  68.   tTask = record
  69.     { tTask describes a task to MULTI. }
  70.     CSIP : pointer;
  71.     { CSIP points to the instruction where the execution
  72.       of this task continues. You could kill a task by
  73.       letting CSIP point to Terminate, but it can't deinit
  74.       then. Use #Poisoned# instead }
  75.     Stack : pointer;
  76.     { Stack points to the first word of the stack of the task.
  77.       Don't change this pointer, or MULTI won't be able to free
  78.       the stack if the task terminates }
  79.     sp : word;
  80.     { This is the Stack Pointer CPU register of that task.
  81.       Don't alter this value ! }
  82.     bp : word;
  83.     { This is the Base Pointer CPU register of that task.
  84.       Don't alter this value ! }
  85.     StackSize : word;
  86.     { This is the number of bytes allocated for the stack of
  87.       the task, don't alter this value ! }
  88.  
  89.     Poisoned,
  90.     {#X Kamikaze Waitfor}
  91.     { If set to TRUE, the task will be terminated soon.
  92.       If #HasExit# is also TRUE, the task will be given the
  93.       chance to deinitialize itself, otherwise #Switch# will
  94.       never return to this task.
  95.       This can be used to terminate a task from outside. A
  96.       task can kill itself by calling #Terminate#. }
  97.     HasExit : boolean;
  98.     { If set to TRUE, and the task is #Poisoned#, too,
  99.       #Switch# will not just cancel the task but it will
  100.       Return TRUE to the task. The task has to deinitialize
  101.       and Terminate then. }
  102.     l,
  103.     { 'Last' pointer; the tasks in the execution queue #t# and
  104.       in #Semaphore# queues are doubly linked with this and #r#. }
  105.     n : pTask;
  106.     { 'Next' pointer; the tasks in the execution queue #t# and
  107.       in #Semaphore# queues are doubly linked with this and #l#. }
  108. {$IFDEF DEBUG}
  109.     s : ^String;
  110.     {#X debug debugdump Dump}
  111.     { Pointer to the name of the task as printed to the monochrome
  112.       monitor as debugging information are displayed.
  113.       This member is only available if DEBUG is $DEFINEd. }
  114. {$ENDIF}
  115.   end;
  116.  
  117.   Semaphore = pTask;
  118.   {#X InitSemaphore WaitFor Release Kamikaze}
  119.   { A semaphore is simply a pointer to a task. The task can be linked to
  120.     other tasks, too (via #tTask.l# and #tTask.n#), which makes up a
  121.     doubly linked list. Semaphores must be initalized with #InitSemaphore#. }
  122.  
  123. const
  124.   t : pTask = nil;
  125.   { This is a pointer to the currently active task. Via #tTask.l# and
  126.     #tTask.n# the task is linked to other tasks producing a ring queue
  127.     of active tasks (i.e. tasks #Switch# could execute if called). }
  128.  
  129. function Fork(p : TaskProc; SSize : word; var v {$IFDEF DEBUG}; const tname : string {$ENDIF}) : pTask;
  130. { p is the procedure you want Fork to execute as a task.
  131.   SSize is the size of the stack to assign to the new task.
  132.   v is a pointer to pass to the task (or #Nothing# if you want to pass nothing)
  133.   tname is the name of the task, for debugging dumps }
  134.  
  135. function Switch : boolean;
  136. { Switch to the next active task.
  137.   If another task sets #tTask.Poisoned#, and #tTask.HasExit# is FALSE,
  138.   Switch does not return from here, but the task is killed instead.
  139.   If #tTask.HasExit# is TRUE, Switch will return #tTask.Poisoned#, and
  140.   when Switch returns TRUE, the task should deinitialize and terminate
  141.   as soon as possible. }
  142. {$IFDEF DEBUG}
  143. procedure Dump;
  144. {#X debug debugdump}
  145. { Dumps a list of the active tasks (i.e. the tasks Switch may execute
  146.   if it is called. This is an example dump :
  147.  
  148.     CS:IP = 1234:5678, SS:SP = 5678:1234            [HasExit] "Main"
  149.     CS:IP = 8763:5187, SS:SP = 9876:5432 [Poisoned]           "KbdIn"
  150.  
  151.     1 of 4 allocated semaphores:
  152.       1234:5678 }
  153. {$ENDIF}
  154.  
  155. procedure Terminate;
  156. { Terminates the calling task. Terminate does not return !
  157.   If the last active task terminates, and there are no #Semaphore#s,
  158.   Terminate halts the program. If there are semaphores, Terminate
  159.   waits for an interrupt to #Release# one.
  160.   To terminate another task, set it's #tTask.Poisoned# flag.
  161.   To terminate all tasks waiting for a semaphore, use #Kamikaze# }
  162.  
  163.  
  164. procedure InitSemaphore(var s : Semaphore);
  165.   { Initialize semaphore as "no tasks are waiting" }
  166. function WaitFor(var a : tTask; var s : Semaphore) : boolean;
  167.   { Waitfor makes a wait for s to be #Release#d.
  168.     Use 't^' as 'a' to make the current task wait.
  169.     Waitfor returns when :
  170.       * s is #Release#d. WaitFor returns FALSE.
  171.       * s is #Kamikaze#d and #tTask.HasExit# is TRUE.
  172.         WaitFor returns TRUE. Deinitialize and #Terminate#
  173.         immediately. }
  174. procedure Release(var s : Semaphore);
  175. {#X Kamikaze}
  176.   { All waiting tasks are inserted in the queue of active
  177.     tasks; the next #Switch# can execute them again, their
  178.     #WaitFor# will return FALSE. }
  179. function Kamikaze(var s : Semaphore) : boolean;
  180. {#X Release}
  181.   { All waiting tasks get their #tTask.Poisoned# set to TRUE.
  182.     Then they are inserted in the queue of active tasks; when
  183.     #Switch# comes to execute them, it will
  184.       * #Terminate# them if #tTask.HasExit# is FALSE.
  185.         Execution of that task is not resumed again.
  186.       * Execute it; their #WaitFor# will return TRUE.
  187.     Kamikaze can be executed on the queue of active tasks #t#, too.
  188.     This will terminate this task, too, or return TRUE if
  189.     tTask.HasExit is TRUE. }
  190.  
  191. const Nothing : byte = 0;
  192. {#X Fork}
  193.   { Use Fork(Task,2048,Nothing) if no parameter is desired }
  194.  
  195. implementation
  196.